subroutine spinout
use para
implicit none
integer::i,j,k,l1,m,n
double precision,external::prod
real(kind=8)::sumjexcn
 character(len=3)::filename
 integer::filenum1,filenum2,filenum3
 filenum1=my_rank/100
 filenum2=(my_rank-filenum1*100)/10
 filenum3=(my_rank-filenum1*100-filenum2*10)
 filename=achar(filenum1+48)//achar(filenum2+48)//achar(filenum3+48)
 
 open(800,file='./configout/spin'//filename//'.dat')
 open(900,file='./configout/udisp'//filename//'.dat')
 open(3000,file='./output/beta_dis.dat')
!output the full configration of the lattice for the next recursion or production run.
toten = 0.0 
doten = 0.0 
sumjexcn=0.0
do i = 1, nlatt, 1
  do j=1, natom,1
    do k=1, natom,1
      do l1=-mmldx, mmldx,1
        do m=-mmldy,mmldy,1
          do n=-mmldz,mmldz,1
            if(n==0 .and. &
              &m==0 .and. &
              &l1==0 .and. &
              &j==k) then
             !if(my_rank==0 .and. i==1) write(*, "(5I3, F10.2)") &
             !&j,k,n,m,l1,jexc(j,k,n,m,l1)
             cycle
            else
            doten(j)=doten(j)+&
            &jexc(j,k,n,m,l1)*&
            &(prod(spin(1,i,j), &
            &spin(:,&
            &mld(n,m,l1,i),k)))
            !if(my_rank==0) sumjexcn=sumjexcn+jexc(j,k,n,m,l1)
            end if
          end do ! n
        end do ! m
      end do ! l1
    end do ! k
  end do !j
end do ! i

do i=1, natom, 1
  toten = toten + doten(i)
  !if(my_rank==0) write(*,"(A7, I3, F12.3)") "DOTE",i,doten(i)
end do
toten=toten/2.0

write(*, *) my_rank, beta(my_rank),toten/nlatt

do i=1,nlatt
  do k=1,natom
  write(800,'(3f10.5)')(spin(j,i,k),j=1,3)
  end do
end do

do i=1,nlatt
  write(900,*)(udis(i,j),j=1,nmod)
end do

if(my_rank==0)then

do i=0,nproc-1
write(3000,*)i,betanum(i),process(i)
end do

end if

 close(800)
 close(900)
 close(3000)
 
end subroutine
